;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "iBlur.lisp")
(require "iimage.lisp")
(require "icommon.lisp")
(module mBlur
  (include-book "avl-rational-keys" :dir :teachpacks)
  (include-book "list-utilities" :dir :teachpacks)
  (import iImage)
  (import iCommon)
  
  (defun sqrt (x n)
    (if (> x 0)
        (if (> n 0)
            (/ (+ (sqrt x (1- n)) (/ x (sqrt x (1- n)))) 2)
            (/ x 2))
        0))
  
  (defun zeta (_Mu_y _Mu_x _y _x _sigma)
    (* (/ 1 (* (expt _sigma 2) 6.283)) (expt 2.718 (round (- (/ (+ (expt (- _x _Mu_x) 2) (expt (- _y _Mu_y) 2)) (* 2 (expt _sigma 2)))) 1))))
 
  (defun weightPt (_px _weight)
    (list (* (car _px) _weight) (* (cadr _px) _weight) (* (caddr _px) _weight)))
  
  (defun epsilon (_Mu_y _Mu_x _y _x _px _sigma)
    (weightPt _px (zeta _Mu_y _Mu_x _y _x _sigma)))
    
  (defun sumPts (_px1 _px2 _px3)
    (if (and (consp _px1) (consp _px2) (consp _px3))
        (list (cap (round (+ (car _px1) (car _px2) (car _px3))  1) 0 255)
              (cap (round (+ (cadr _px1) (cadr _px2) (cadr _px3))  1) 0 255)
              (cap (round (+ (caddr _px1) (caddr _px2) (caddr _px3)) 1) 0 255))
        (if (consp _px2)
          (list (cap (round (+ (car _px1) (car _px2))  1) 0 255)
                (cap (round (+ (cadr _px1) (cadr _px2)) 1) 0 255)
                (cap (round (+ (caddr _px1) (caddr _px2)) 1) 0 255))
          (if (consp _px3)
              (list (cap (round (+ (car _px1) (car _px3)) 1) 0 255)
                    (cap (round (+ (cadr _px1) (cadr _px3)) 1) 0 255)
                    (cap (round (+ (caddr _px1) (caddr _px3)) 1) 0 255))
              (list (cap (round (car _px1)  1) 0 255)
                    (cap (round (cadr _px1)  1) 0 255)
                    (cap (round (caddr _px1) 1) 0 255))))))
  
  (defun delta (_Mu_y _Mu_x _y _tr _sigma)
    (if (consp _tr)
        (if (> (- (key _tr) _Mu_x) (* 3 _sigma))
            (delta _Mu_y _Mu_x _y (left _tr) _sigma)
            (if (< (- (key _tr) _Mu_x) (- (* 3 _sigma)))
                (delta _Mu_y _Mu_x _y (right _tr) _sigma)
                (sumPts (epsilon _Mu_y _Mu_x _y (key _tr) (data _tr) _sigma)
                        (delta _Mu_y _Mu_x _y (left _tr) _sigma)
                        (delta _Mu_y _Mu_x _y (right _tr) _sigma))))
        ()))
  
  (defun gamma (_Mu_y _Mu_x _tr _sigma)
    (if (consp _tr)
        (if (> (- (key _tr) _Mu_y) (* 3 _sigma))
            (gamma _Mu_y _Mu_x (left _tr) _sigma)
            (if (< (- (key _tr) _Mu_y) (- (* 3 _sigma)))
                (gamma _Mu_y _Mu_x (right _tr) _sigma)
                (sumPts (delta _Mu_y _Mu_x (key _tr) (data _tr) _sigma) 
                        (gamma _Mu_y _Mu_x (left _tr) _sigma) 
                        (gamma _Mu_y _Mu_x (right _tr) _sigma))))
        ()))
  
  (defun beta (_Mu_y _tr1 _tr2 _sigma _x _y _r)
    (if (consp _tr1)
        (if (and (natp _x) (natp _y) (natp _r))
            (if (< (sqrt (+ (expt (- (key _tr1) _x) 2) (expt (- _Mu_y _y) 2)) 10) _r)
                (tree (key _tr1) (gamma _Mu_y (key _tr1) _tr2 _sigma) (beta _Mu_y (left _tr1) _tr2 _sigma _x _y _r) (beta _Mu_y (right _tr1) _tr2 _sigma _x _y _r))
                (tree (key _tr1) (data _tr1) (beta _Mu_y (left _tr1) _tr2 _sigma _x _y _r) (beta _Mu_y (right _tr1) _tr2 _sigma _x _y _r)))
            (tree (key _tr1) (gamma _Mu_y (key _tr1) _tr2 _sigma) (beta _Mu_y (left _tr1) _tr2 _sigma _x _y _r) (beta _Mu_y (right _tr1) _tr2 _sigma _x _y _r)))
        ()))
  
  (defun alpha (_tr1 _tr2 _sigma _x _y _r)
    (if (consp _tr1)
        (tree (key _tr1) (beta (key _tr1) (data _tr1) _tr2 _sigma _x _y _r) (alpha (left _tr1) _tr2 _sigma _x _y _r) (alpha (right _tr1) _tr2 _sigma _x _y _r))
        ()))
  
  (defun MainBlur (tree args)
    (let* ((header (cdr (avl-retrieve tree -1)))
           (width (getWidth tree))
           (height (getHeight tree))
           (_tr (avl-delete (avl-delete (avl-delete tree -1) -2) -3)))
      (mv (avl-insert (avl-insert (avl-insert 
                                   (alpha _tr _tr (car args) (cadr args) (caddr args) (cadddr args))
                                   -1 header) -2 width) -3 height) (list "Blur Successful"))))
  
  (export iBlur))